home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / perl5 / JSON / PP5005.pm < prev    next >
Encoding:
Perl POD Document  |  2009-06-02  |  3.1 KB  |  149 lines
  1. package JSON::PP5005;
  2.  
  3. use 5.005;
  4. use strict;
  5.  
  6. my @properties;
  7.  
  8. $JSON::PP5005::VERSION = '1.09';
  9.  
  10. BEGIN {
  11.  
  12.     sub utf8::is_utf8 {
  13.         0; # It is considered that UTF8 flag off for Perl 5.005.
  14.     }
  15.  
  16.     sub utf8::upgrade {
  17.     }
  18.  
  19.     sub utf8::downgrade {
  20.         1; # must always return true.
  21.     }
  22.  
  23.     sub utf8::encode  {
  24.     }
  25.  
  26.     sub utf8::decode {
  27.     }
  28.  
  29.     *JSON::PP::JSON_PP_encode_ascii      = \&_encode_ascii;
  30.     *JSON::PP::JSON_PP_encode_latin1     = \&_encode_latin1;
  31.     *JSON::PP::JSON_PP_decode_surrogates = \&_decode_surrogates;
  32.     *JSON::PP::JSON_PP_decode_unicode    = \&_decode_unicode;
  33.  
  34.     # missing in B module.
  35.     sub B::SVf_IOK () { 0x00010000; }
  36.     sub B::SVf_NOK () { 0x00020000; }
  37.     sub B::SVf_POK () { 0x00040000; }
  38.     sub B::SVp_IOK () { 0x01000000; }
  39.     sub B::SVp_NOK () { 0x02000000; }
  40.  
  41.     $INC{'bytes.pm'} = 1; # dummy
  42. }
  43.  
  44.  
  45.  
  46. sub _encode_ascii {
  47.     join('', map { $_ <= 127 ? chr($_) : sprintf('\u%04x', $_) } unpack('C*', $_[0]) );
  48. }
  49.  
  50.  
  51. sub _encode_latin1 {
  52.     join('', map { chr($_) } unpack('C*', $_[0]) );
  53. }
  54.  
  55.  
  56. sub _decode_surrogates { # from http://homepage1.nifty.com/nomenclator/unicode/ucs_utf.htm
  57.     my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00); # from perlunicode
  58.     my $bit = unpack('B32', pack('N', $uni));
  59.  
  60.     if ( $bit =~ /^00000000000(...)(......)(......)(......)$/ ) {
  61.         my ($w, $x, $y, $z) = ($1, $2, $3, $4);
  62.         return pack('B*', sprintf('11110%s10%s10%s10%s', $w, $x, $y, $z));
  63.     }
  64.     else {
  65.         Carp::croak("Invalid surrogate pair");
  66.     }
  67. }
  68.  
  69.  
  70. sub _decode_unicode {
  71.     my ($u) = @_;
  72.     my ($utf8bit);
  73.  
  74.     if ( $u =~ /^00([89a-f][0-9a-f])$/i ) { # 0x80-0xff
  75.          return pack( 'H2', $1 );
  76.     }
  77.  
  78.     my $bit = unpack("B*", pack("H*", $u));
  79.  
  80.     if ( $bit =~ /^00000(.....)(......)$/ ) {
  81.         $utf8bit = sprintf('110%s10%s', $1, $2);
  82.     }
  83.     elsif ( $bit =~ /^(....)(......)(......)$/ ) {
  84.         $utf8bit = sprintf('1110%s10%s10%s', $1, $2, $3);
  85.     }
  86.     else {
  87.         Carp::croak("Invalid escaped unicode");
  88.     }
  89.  
  90.     return pack('B*', $utf8bit);
  91. }
  92.  
  93.  
  94. sub JSON::PP::incr_parse {
  95.     local $Carp::CarpLevel = 1;
  96.     ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_parse( @_ );
  97. }
  98.  
  99.  
  100. sub JSON::PP::incr_text {
  101.     $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new;
  102.  
  103.     if ( $_[0]->{_incr_parser}->{incr_parsing} ) {
  104.         Carp::croak("incr_text can not be called when the incremental parser already started parsing");
  105.     }
  106.  
  107.     $_[0]->{_incr_parser}->{incr_text} = $_[1] if ( @_ > 1 );
  108.     $_[0]->{_incr_parser}->{incr_text};
  109. }
  110.  
  111.  
  112. sub JSON::PP::incr_skip {
  113.     ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_skip;
  114. }
  115.  
  116.  
  117. sub JSON::PP::incr_reset {
  118.     ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_reset;
  119. }
  120.  
  121.  
  122. 1;
  123. __END__
  124.  
  125. =pod
  126.  
  127. =head1 NAME
  128.  
  129. JSON::PP5005 - Helper module in using JSON::PP in Perl 5.005
  130.  
  131. =head1 DESCRIPTION
  132.  
  133. JSON::PP calls internally.
  134.  
  135. =head1 AUTHOR
  136.  
  137. Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
  138.  
  139.  
  140. =head1 COPYRIGHT AND LICENSE
  141.  
  142. Copyright 2007-2009 by Makamaka Hannyaharamitu
  143.  
  144. This library is free software; you can redistribute it and/or modify
  145. it under the same terms as Perl itself. 
  146.  
  147. =cut
  148.  
  149.